home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol059 / dataone.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-13  |  8.0 KB  |  164 lines
  1. 1  '                 STATISTICAL DATA ENTRY PROGRAM
  2. 2  '               Copyright Tracy L. Gustafson, M.D.
  3. 3  '              Round Rock, Texas. Version 3.0, 1984
  4. 4  ON ERROR GOTO 5000:CHAIN MERGE "EPIMRG",5
  5. 15  DIM D(1,1),CS(1,1),T(1),N$(1),X(1),X2(1),MD(1),SD(1)
  6. 22  DATA "STATISTICAL DATA ENTRY PROGRAM",20,32
  7. 30  LOCATE 6,27:PRINT "1.) INITIAL DATA ENTRY"
  8. 35  PRINT:PRINT TAB(27);"2.) APPEND DATA"
  9. 40  PRINT:PRINT TAB(27);"3.) EDIT DATA"
  10. 45  PRINT:PRINT TAB(27);"4.) PRINT DATA"
  11. 50  PRINT:PRINT TAB(27);"5.) SAVE DATA TO DISK"
  12. 55  PRINT:PRINT TAB(27);"6.) LOAD DATA FROM DISK"
  13. 60  PRINT:PRINT TAB(27);"7.) EXIT":PRINT
  14. 65  PRINT TAB(27);:INPUT "Enter choice:   ",ASUB:IF ABS(ASUB-4)>3 THEN BEEP:GOTO 65
  15. 70  ON ASUB GOTO 155,355,375,505,735,750,775
  16. 75  COLOR CLR2,CLR1:LOCATE 25,35:PRINT " F2 = NO DATA ";:LOCATE ,55:PRINT " F10 = STOP ";:COLOR CLR1,CLR2:LOCATE AR,1:RETURN
  17. 80  GOSUB 75:TB=1:PRINT "Sample Name = ";:IF APND=1 THEN PRINT N$(1) ELSE INPUT "",N$(1)
  18. 85  C=C+1:PRINT USING "###";C;:PRINT ": ";
  19. 90  INPUT;"",DI:IF DI="" THEN 120
  20. 95  VC=VAL(DI):T(1)=T(1)+1:X(1)=X(1)+VC:X2(1)=X2(1)+VC*VC
  21. 100  FOR Z=1 TO T(1)-1:VX=VAL(D(1,CS(1,Z))):IF VX<=VC THEN 110
  22. 105  FOR TZ=T(1) TO Z+1 STEP -1:CS(1,TZ)=CS(1,TZ-1):NEXT:GOTO 115
  23. 110  NEXT Z
  24. 115  CS(1,Z)=C
  25. 120  A$=INKEY$:IF A$="" THEN 120 ELSE IF A$=CHR$(13) THEN 125 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1)):IF AI=68 THEN D(1,C)=DI:GOTO 150 ELSE IF AI=60 THEN 130 ELSE 120 ELSE 120
  26. 125  IF DI="" THEN BEEP:GOTO 90
  27. 130  D(1,C)=DI:TB=TB+13:IF TB>70 THEN TB=1
  28. 135  PRINT TAB(TB);:GOTO 85
  29. 140  AR=CSRLIN:LOCATE 25,30:PRINT TAB(79):IF AR>22 THEN PRINT:PRINT:LOCATE 24,1 ELSE LOCATE AR+2,1
  30. 145  RETURN
  31. 150  GOSUB 140:GOSUB 305:OPEN "SCRN:" FOR OUTPUT AS #1:GOTO 595
  32. 155  PRINT:INPUT "  How many samples or variables would you like to enter? (1 to 28)   ",A:IF A<1 OR A>28 THEN BEEP:GOTO 155
  33. 160  GOSUB 350:APND=0:ERASE D,CS,N$,X,X2,T,MD,SD
  34. 165  DIM D(A,2000/A),CS(A,2000/A),N$(A),X(A),X2(A),T(A),MD(A),SD(A)
  35. 170  C=0:FILE$="":PRINT "First NAME your samples or variables, then ENTER ";
  36. 175  PRINT "data:"
  37. 180  PRINT TAB(16);"1.) Press `RETURN' twice to continue data entry."
  38. 185  PRINT TAB(16);"2.) Press `RETURN' then F2 if no data for that cell."
  39. 190  PRINT TAB(16);"3.) Press `RETURN' then F10 after last data entry."
  40. 195  PRINT:AR=CSRLIN:IF A=1 THEN 80
  41. 200  FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
  42. 205  A1=AS*7+1:SCREEN ,,AS,0
  43. 210  FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-3);"Sample";T;:NEXT:GOSUB 75:NEXT AS
  44. 215  PRINT:AR=CSRLIN
  45. 220  FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
  46. 225  A1=AS*7+1:SCREEN ,,AS,(APND=0)*(-AS):LOCATE AR,1:PRINT "NAME=";
  47. 230  FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-3);:IF APND=1 THEN PRINT N$(T); ELSE INPUT;"",N$(T)
  48. 235  NEXT:NEXT AS
  49. 240  PRINT:AR=CSRLIN:C=C+1
  50. 245  FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
  51. 250  A1=AS*7+1:SCREEN ,,AS,AS:LOCATE AR,1:PRINT USING "###";C;:PRINT ":";
  52. 255  FOR T=A1 TO A2:PRINT TAB((T-A1+1)*10-3);
  53. 260  INPUT;"",DI:VC=VAL(DI):IF DI="" THEN 290
  54. 265  VC=VAL(DI):T(T)=T(T)+1:X(T)=X(T)+VC:X2(T)=X2(T)+VC*VC
  55. 270  FOR Z=1 TO T(T)-1:VX=VAL(D(T,CS(T,Z))):IF VX<=VC THEN 280
  56. 275  FOR TZ=T(T) TO Z+1 STEP -1:CS(T,TZ)=CS(T,TZ-1):NEXT:GOTO 285
  57. 280  NEXT Z
  58. 285  CS(T,Z)=C
  59. 290  A$=INKEY$:IF A$="" THEN 290 ELSE IF A$=CHR$(13) THEN 295 ELSE IF LEN(A$)=2 THEN AI=ASC(RIGHT$(A$,1)):IF AI=68 THEN D(T,C)=DI:GOSUB 320 ELSE IF AI=60 THEN 300 ELSE 290 ELSE 290
  60. 295  IF DI="" THEN BEEP:GOTO 260
  61. 300  D(T,C)=DI:NEXT T:NEXT AS:GOTO 240
  62. 305  SCREEN ,,0:FOR T=1 TO A:N=T(T):IF N>1 THEN IF X2(T)>X(T)*X(T)/N THEN SD(T)=SQR((X2(T)-X(T)*X(T)/N)/(N-1))
  63. 310  IF N>0 THEN IF N MOD 2=0 THEN MD(T)=(VAL(D(T,CS(T,N/2)))+VAL(D(T,CS(T,N/2+1))))*0.5 ELSE MD(T)=VAL(D(T,CS(T,N/2+0.5)))
  64. 315  NEXT:RETURN
  65. 320  GOSUB 305:PO$="SCRN:":OPEN PO$ FOR OUTPUT AS #1
  66. 325  FOR AS=0 TO INT((A-1)/7):A2=AS*7+7:IF A2>A THEN A2=A
  67. 330  A1=AS*7+1:SCREEN ,,AS,AS:LOCATE AR,1:GOSUB 140
  68. 335  GOSUB 665:NEXT AS:CLOSE #1:GOTO 20
  69. 340  IF MB>9999 THEN P$="#######.#" ELSE IF MB>99 THEN P$="#####.###" ELSE IF MB>=10 THEN P$="###.#####" ELSE P$="##.######"
  70. 345  RETURN
  71. 350  FOR AS=0 TO INT((A-1)/7):SCREEN ,,AS,0:CLS:NEXT:SCREEN ,,0:RETURN
  72. 355  GOSUB 350:PRINT TAB(33);"APPEND DATA": PRINT TAB(33);STRING$(11,205):APND=1
  73. 360  PRINT TAB(16);"There are ";A;" sample groups in this datafile.":PRINT
  74. 365  IF A=0 THEN BEEP:PRINT "     You must enter a datafile from keyboard or disk before using APPEND.":GOTO 765
  75. 370  PRINT "APPEND your ";:GOTO 175
  76. 375  CLS:PRINT TAB(34);"EDIT DATA":PRINT TAB(34);STRING$(9,205):PRINT
  77. 380  PRINT TAB(14);"There are ";A; "sample groups in this datafile.":PRINT
  78. 385  PRINT TAB(7);"1.)  Enter positive record number to REPLACE a record."
  79. 390  PRINT TAB(7);"2.)  Enter negative record number to DELETE a record."
  80. 395  PRINT TAB(7);"3.)  Press F2 to change a sample NAME."
  81. 400  PRINT TAB(7);"4.)  Press F10 to exit from EDIT session."
  82. 405  KEY 2,"98"+CHR$(13):KEY 10,"99"+CHR$(13):AR=CSRLIN:LOCATE 25,32:COLOR CLR2,CLR1:PRINT " F2 = CHANGE NAME ";:LOCATE ,55:PRINT " F10 = EXIT ";:COLOR CLR1,CLR2:LOCATE AR+1,1
  83. 410  PRINT "Sample #";TAB(20);"Record #";TAB(40);"Old value";TAB(60);"New value"
  84. 415  F=0:AR=CSRLIN:LOCATE AR,3:INPUT;"",B:IF B=99 THEN 500 ELSE IF B=98 THEN 490 ELSE IF B<1 OR B>A THEN BEEP:GOTO 415
  85. 420  LOCATE AR,23:INPUT;"",BR:IF ABS(BR)>C OR BR=0 THEN BEEP:GOTO 420
  86. 425  IF BR<0 THEN F=1:BR=-BR:IF D(B,BR)="" THEN PRINT:GOTO 415 ELSE 440
  87. 430  PRINT TAB(40);D(B,BR);:LOCATE AR,60:INPUT "",DI:VN=VAL(DI)
  88. 435  IF D(B,BR)="" THEN T(B)=T(B)+1:GOTO 465
  89. 440  VC=VAL(D(B,BR)):X(B)=X(B)-VC:X2(B)=X2(B)-VC*VC
  90. 445  FOR Z=1 TO T(B)-1:IF CS(B,Z)<>BR THEN 455
  91. 450  FOR TZ=Z TO T(B)-1:CS(B,TZ)=CS(B,TZ+1):NEXT:GOTO 460
  92. 455  NEXT Z
  93. 460  IF F=1 THEN D(B,BR)="":T(B)=T(B)-1:PRINT:GOTO 415
  94. 465  D(B,BR)=DI:X(B)=X(B)+VN:X2(B)=X2(B)+VN*VN
  95. 470  FOR Z=1 TO T(B)-1:VX=VAL(D(B,CS(B,Z))):IF VX<=VN THEN 480
  96. 475  FOR TZ=T(B) TO Z+1 STEP -1:CS(B,TZ)=CS(B,TZ-1):NEXT:GOTO 485
  97. 480  NEXT Z
  98. 485  CS(B,Z)=BR:GOTO 415
  99. 490  LOCATE AR,1:PRINT "Sample #";TAB(20);"Old name";TAB(40);"New name"
  100. 495  LOCATE ,3:INPUT;"",B:IF B>A OR B=0 THEN BEEP:GOTO 495 ELSE PRINT TAB(20);:PRINT N$(B);TAB(40);:INPUT "",N$(B):GOTO 410
  101. 500  LOCATE 25,60:PRINT TAB(79);:KEY 10,"":KEY 2,"":GOSUB 305:GOTO 20
  102. 505  CLS:PRINT TAB(25);"PRINT DATAFILE ";FILE$:PRINT TAB(25);STRING$(LEN(FILE$)+15,205):PRINT
  103. 510  INPUT " Do you want the DATAFILE printed in SORTED or INPUT order? (S or I)  ",A$
  104. 515  IF A$="i" OR A$="I" THEN BSRT=0:GOTO 525 ELSE IF A$="s" OR A$="S" THEN BSRT=1 ELSE BEEP:GOTO 510
  105. 520  IF A>1 THEN PRINT TAB(12);:PRINT "Which sample number do you wish to SORT by?";:AR=CSRLIN:AC=57:GOSUB 4200
  106. 525  PRINT:PRINT TAB(8);:INPUT "Do you want to print data on SCREEN or PRINTER? (S or P)   ",A$
  107. 530  IF A$="P" OR A$="p" THEN PO$="LPT1:":PMAX=PRNT-10 ELSE IF A$="S" OR A$="s" THEN PO$="SCRN:":GOSUB 350:PMAX=70:GOTO 545 ELSE BEEP:GOTO 525
  108. 535  PRINT:PRINT TAB(23); "Be sure paper is in printer.":PRINT:PRINT TAB(24);"Press any key when ready:"
  109. 540  A$=INKEY$:IF A$="" THEN 540
  110. 545  ON ERROR GOTO 5070:OPEN PO$ FOR OUTPUT AS #1:IF PO$="LPT1:" THEN WIDTH #1,255:PRINT #1,TYP$;
  111. 550  IF A>1 THEN 610 ELSE IF A=0 THEN BEEP:PRINT:PRINT TAB(18);"There is no data in this datafile.":CLOSE #1:GOTO 765
  112. 555  PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,
  113. 560  PRINT #1,"Sample Name = ";N$(1):PRINT #1,:TB=1:IF BSRT=1 THEN 580
  114. 565  FOR Z=1 TO C:PRINT #1,USING "###";Z;:PRINT #1,":";D(1,Z);
  115. 570  TB=TB+13:IF TB>PMAX THEN TB=1
  116. 575  PRINT #1,TAB(TB);:NEXT:GOTO 595
  117. 580  FOR Z=1 TO T(1):PRINT #1,USING "###";CS(1,Z);:PRINT #1,": ";D(1,CS(1,Z));
  118. 585  TB=TB+13:IF TB>PMAX THEN TB=1
  119. 590  PRINT #1,TAB(TB);:NEXT
  120. 595  IF T(1)=0 THEN MN=0 ELSE MN=X(1)/T(1)
  121. 600  PRINT #1,:PRINT #1,:PRINT #1,TAB(5);"TOTAL =";T(1);TAB(26);"MEAN =";MN;TAB(55);"MEDIAN =";MD(1)
  122. 605  PRINT #1,:PRINT #1,TAB(20);"STANDARD DEVIATION =";SD(1):CLOSE #1:GOTO 765
  123. 610  AR=CSRLIN:FOR AS=0 TO INT((A-1)*10/PMAX):A2=(AS+1)*PMAX/10:IF A2>A THEN A2=A
  124. 615  A1=AS*PMAX/10+1:IF PO$="SCRN:" THEN SCREEN ,,AS,AS:LOCATE AR,1
  125. 620  PRINT #1,TAB(PMAX/2-8);"DATAFILE ";FILE$:PRINT #1,
  126. 625  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);"Sample";T;:NEXT:PRINT #1,
  127. 630  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);N$(T);:NEXT:PRINT #1,:PRINT #1,
  128. 635  IF BSRT=1 THEN 650
  129. 640  FOR Z=1 TO C:PRINT #1,USING "###";Z;:PRINT #1,":";
  130. 645  FOR T=A1 TO A2: PRINT #1,TAB((T-A1+1)*10-3);D(T,Z);:NEXT:PRINT #1,:NEXT:GOTO 660
  131. 650  FOR Z=1 TO T(NS):PRINT #1,USING "###";CS(NS,Z);:PRINT #1,":";
  132. 655  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-3);D(T,CS(NS,Z));:NEXT:PRINT #1,:NEXT
  133. 660  GOSUB 665:NEXT AS:CLOSE #1:GOTO 20
  134. 665  PRINT #1,:PRINT #1,"NO.";:P$="#####"
  135. 670  FOR T=A1 TO A2:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;T(T);:NEXT
  136. 675  PRINT #1,:PRINT #1,"MEAN";
  137. 680  FOR T=A1 TO A2:IF T(T)>0 THEN MN=X(T)/T(T) ELSE MN=0
  138. 685  MB=ABS(MN):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MN;:NEXT
  139. 690  PRINT #1,:PRINT #1,"MED";
  140. 695  FOR T=A1 TO A2:MB=ABS(MD(T)):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;MD(T);:NEXT
  141. 700  PRINT #1,:PRINT #1,"SDEV";
  142. 705  FOR T=A1 TO A2:MB=SD(T):GOSUB 340:PRINT #1,TAB((T-A1+1)*10-4);:PRINT #1,USING P$;SD(T);:NEXT
  143. 710  PRINT #1,:PRINT:IF A2=A THEN 725
  144. 715  IF PO$="LPT1:" THEN PRINT #1,CHR$(12)
  145. 720  LOCATE 24,23:PRINT "Press `P' to print next page:";
  146. 725  LOCATE 25,21:PRINT "Press space bar to return to menu.";
  147. 730  A$=INKEY$:IF A$="" THEN 730 ELSE IF A$="p" OR A$="P" THEN LOCATE 24,1:PRINT TAB(80):LOCATE 25,1:PRINT TAB(79):RETURN ELSE IF A$=CHR$(32) THEN CLOSE #1:GOTO 20 ELSE BEEP:GOTO 730
  148. 735  CLS:PRINT TAB(28);"SAVING DATA TO DISK":PRINT TAB(28);STRING$(19,205)
  149. 740  PRINT:AR=CSRLIN:GOSUB 4100
  150. 745  PRINT:PRINT:PRINT TAB(20); "Your data has been saved in ";FILE$:GOTO 765
  151. 750  CLS:PRINT TAB(26);"LOADING DATA FROM DISK":PRINT TAB(26);STRING$(22,205)
  152. 755  PRINT:GOSUB 4000
  153. 760  PRINT:PRINT:PRINT TAB(20); FILE$;" has been loaded from disk."
  154. 765  LOCATE 25,10:PRINT TAB(19);"Press any key to return to main menu:";TAB(75);
  155. 770  A$=INKEY$:IF A$="" THEN 770 ELSE SCREEN ,,0:GOTO 20
  156. 775  PRINT:PRINT TAB(10);:INPUT "Have you saved your current data to disk? (Y or N)    ",A$
  157. 780  IF A$<>"y" AND A$<>"Y" THEN 20
  158. 785  END
  159. 4025  ERASE D,CS,T,N$,X,X2,MD,SD
  160. 4030  DIM D(A,2000/A),CS(A,2000/A),T(A),N$(A),X(A),X2(A),MD(A),SD(A)
  161. 5000  BEEP:IF ERR<>53 AND ERR<>71 THEN 5010 ELSE LOCATE 10,10:PRINT "Please place EPISTAT in drive A: (or other default).":PRINT TAB(25);"Press any key to continue:"
  162. 5005  A$=INKEY$:IF A$="" THEN 5005 ELSE RESUME
  163. 5010  ON ERROR GOTO 0:END
  164.